home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / src / X11 / tclMotif-1.4 / doc / examples / popup.tcl < prev    next >
Encoding:
Text File  |  1995-06-29  |  1.2 KB  |  53 lines
  1. #! tiv
  2.  
  3. proc createPopup {name inside} {
  4.     xmFormDialog $name
  5.  
  6.     if {[catch $inside area] != 2} {
  7.         error "Error while evaluating $inside" $area
  8.     }
  9.  
  10.     $area manageChild
  11.     xmSeparator $name.Separator managed
  12.     xmPushButton $name.OK managed -background green
  13.     xmPushButton $name.Cancel managed -background red
  14.  
  15.     $area setValues \
  16.         -topAttachment attach_form \
  17.         -leftAttachment attach_form \
  18.         -rightAttachment attach_form \
  19.         -bottomAttachment attach_widget -bottomWidget $name.Separator
  20.  
  21.     $name.Separator setValues \
  22.         -leftAttachment attach_form \
  23.         -rightAttachment attach_form \
  24.         -bottomAttachment attach_widget -bottomWidget $name.OK
  25.  
  26.     $name.OK setValues \
  27.         -leftAttachment attach_form \
  28.         -bottomAttachment attach_form
  29.  
  30.     $name.Cancel setValues \
  31.         -leftAttachment attach_widget -leftWidget $name.OK \
  32.         -leftOffset 20 \
  33.         -bottomAttachment attach_form
  34.  
  35.     $name.OK     activateCallback "set $name.exitFlag 1"
  36.     $name.Cancel activateCallback "set $name.exitFlag 0"
  37. }
  38.  
  39. proc doModalPopup {name} {
  40.     global $name.exitFlag
  41.     set $name.exitFlag -1
  42.  
  43.     $name setValues -dialogStyle dialog_full_application_modal
  44.     $name manageChild
  45.  
  46.     while {[eval set $name.exitFlag] == -1} {
  47.         . processEvent
  48.     }
  49.     $name unmanageChild
  50.  
  51.     return [set $name.exitFlag]
  52. }
  53.